home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / autocad / 3dcabin.arj / 3DCABN.LSP next >
Text File  |  1993-10-21  |  5KB  |  97 lines
  1. ;3DCABNT.LSP - WRITTEN BY JAN TAYLOR 
  2. ;              FOR AUTOLISP CLASS DR238
  3. ;              BILLINGS VOCATIONAL TECHNICAL CENTER
  4. ;              BILLINGS, MONTANA
  5. ;              FEBRUARY 20, 1991
  6. ;THIS PROGRAM WILL DRAW A CABINET GIVEN THE WIDTH, HEIGHT, DEPTH, 
  7. ;THICKNESS OF MATERIAL USED, COUNTERTOP OVERHANG, THICKNESS OF COUNTERTOP, AND 
  8. ;HEIGHT OF THE SHELF. THIS PROGRAM WILL ALSO SET A "CABINET" LAYER AT THE 
  9. ;BEGINNING.  SIMPLY PICK THE BEGINNING POINT AND ANSWER THE QUESTIONS 
  10. ;AND WAA-LAA!-CABINETS!!! 
  11. ;IF YOU INTEND TO USE THIS PROGRAM FOR WALL CABINETS, BE SURE TO USE "0" FOR 
  12. ;THICKNESS OF COUNTERTOP AND COUNTERTOP OVERHANG.
  13. ;
  14. ;NOTE: The DTR and RTD functions must be defined in your ACAD.LSP program
  15. ;
  16. ;Send comments to Compuserve Account #76264,2273
  17. ;*****************************************************************************
  18. (DEFUN C:3DCABNT ()
  19. (GRAPHSCR)
  20. (SETVAR "CMDECHO" 0)
  21. (SETVAR "BLIPMODE" 0)
  22. (SETQ P1 (GETPOINT "\nPICK THE LOWER LEFT-HAND SIDE OF THE CABINET: "))
  23. (SETQ W (GETDIST "\nWHAT IS THE WIDTH OF THE CABINET?: "))
  24. (SETQ D (GETDIST "\nWHAT IS THE DEPTH OF THE CABINET?: "))
  25. (SETQ H (GETDIST "\nWHAT IS THE HEIGHT OF THE CABINET?: "))
  26. (SETQ OH (GETDIST "\nHOW MUCH OVERHANG DO YOU WANT?: "))
  27. (SETQ T (GETDIST "\nWHAT IS THE THICKNESS OF THE MATERIAL USED?: "))
  28. (SETQ CT (GETDIST "\nWHAT IS THE THICKNESS OF THE COUNTER TOP?: "))
  29. (SETQ S (GETDIST "\nWHAT IS THE HEIGHT OF THE FIRST SHELF?: "))
  30.      (COMMAND "LAYER" "N" "CABINET" "C" "RED" "" "")
  31.      (SETQ P2 (POLAR P1 (DTR 0) W))
  32.      (SETQ P3 (POLAR P2 (DTR 90) D))
  33.      (SETQ P4 (POLAR P1 (DTR 90) D))
  34.      (SETQ P5 (LIST (CAR P1) (CADR P1) H))
  35.      (SETQ P6 (POLAR P5 (DTR 0) W))
  36.      (SETQ P7 (POLAR P6 (DTR 90) D))
  37.      (SETQ P8 (POLAR P5 (DTR 90) D))
  38. (SETQ P9 (LIST (+ (CAR P1) T) (CADR P1) (+ (CADDR P1) T)))
  39. (SETQ P10 (LIST (- (CAR P2) T) (CADR P2) (+ (CADDR P2) T)))
  40. (SETQ P11 (LIST (- (CAR P3) T) (CADR P3) (+ (CADDR P3) T)))
  41. (SETQ P12 (LIST (+ (CAR P4) T) (CADR P4) (+ (CADDR P4) T)))
  42. (SETQ P14 (LIST (CAR P10) (CADR P10) (- H T)))
  43. (SETQ P13 (LIST (CAR P9) (CADR P9) (- H T)))
  44. (SETQ P15 (LIST (CAR P11) (CADR P11) (- H T)))
  45. (SETQ P16 (LIST (CAR P12) (CADR P12) (- H T)))
  46.              (COMMAND "3DFACE" P1 P5 P8 P4 "")
  47.              (COMMAND "3DFACE" P2 P6 P7 P3 "")
  48.              (COMMAND "3DFACE" P5 P6 P7 P8 "")
  49.              (COMMAND "3DFACE" P1 P2 P3 P4 "")
  50.              (COMMAND "3DFACE" P9 P10 P11 P12 "")
  51.              (COMMAND "3DFACE" P10 P11 P15 P14 "")
  52.              (COMMAND "3DFACE" P9 P12 P16 P13 "")
  53.              (COMMAND "3DFACE" P13 P14 P15 P16 "")
  54.              (COMMAND "3DFACE" P1 P9 P13 P5 "")
  55.              (COMMAND "3DFACE" P1 P9 P10 P2 "")
  56.              (COMMAND "3DFACE" P2 P10 P14 P6 "")
  57.              (COMMAND "3DFACE" P6 P14 P13 P5 "")
  58. (SETQ P17 (LIST (CAR P9) (CADR P9) S))
  59. (SETQ P18 (LIST (CAR P10) (CADR P10) S))
  60. (SETQ P19 (LIST (CAR P11) (CADR P11) S))
  61. (SETQ P20 (LIST (CAR P12) (CADR P12) S))
  62.              (COMMAND "3DFACE" P17 P18 P19 P20 "")
  63. (SETQ P21 (LIST (CAR P17) (CADR P17) (- (CADDR P17) T)))
  64. (SETQ P22 (LIST (CAR P18) (CADR P18) (- (CADDR P18) T)))
  65. (SETQ P23 (LIST (CAR P20) (CADR P20) (- (CADDR P20) T)))
  66. (SETQ P24 (LIST (CAR P19) (CADR P19) (- (CADDR P19) T)))
  67.              (COMMAND "3DFACE" P21 P22 P24 P23 "")
  68.              (COMMAND "3DFACE" P17 P18 P22 P21 "")
  69. (SETQ P25 (LIST (CAR P6) (- (CADR P6) OH) (CADDR P6)))
  70. (SETQ P26 (LIST (CAR P25) (CADR P25) (+ (CADDR P25) CT)))
  71. (SETQ P27 (LIST (CAR P5) (- (CADR P5) OH) (+ (CADDR P5) CT)))
  72. (SETQ P28 (LIST (CAR P27) (CADR P27) (- (CADDR P27) CT)))
  73.              (COMMAND "3DFACE" P25 P26 P27 P28 "")
  74. (SETQ P29 (LIST (CAR P7) (CADR P7) (+ (CADDR P7) CT)))
  75. (SETQ P30 (LIST (CAR P8) (CADR P7) (+ (CADDR P8) CT)))
  76.              (COMMAND "3DFACE" P25 P26 P29 P7 "")
  77.              (COMMAND "3DFACE" P7 P29 P30 P8 "")
  78.              (COMMAND "3DFACE" P8 P30 P27 P28 "")
  79.              (COMMAND "3DFACE" P27 P26 P29 P30 "")
  80.              (COMMAND "3DFACE" P5 P28 P25 P6 "")
  81. (SETQ P31 (LIST (- (CAR P2) (/ T 2)) (CADR P2) (+ (CADDR P2) (/ T 2))))
  82. (SETQ P32 (LIST (CAR P31) (CADR P31) (+ (CADDR P31) (- H (/ T 2)))))
  83. (SETQ P33 (LIST (+ (CAR P5) (/ T 2)) (CADR P5) (+ (CADDR P32) (/ T 2))))
  84. (SETQ P34 (LIST (CAR P33) (CADR P33) (+ (CADDR P1) (/ T 2))))
  85.              (COMMAND "3DFACE" P31 P32 P33 P34 "")
  86. (SETQ P35 (LIST (CAR P31) (- (CADR P31) T) (CADDR P31)))
  87. (SETQ P36 (LIST (CAR P32) (- (CADR P32) T) (CADDR P32)))
  88. (SETQ P37 (LIST (CAR P33) (- (CADR P33) T) (CADDR P33)))
  89. (SETQ P38 (LIST (CAR P34) (- (CADR P34) T) (CADDR P34)))
  90.              (COMMAND "3DFACE" P35 P36 P37 P38 "")
  91.              (COMMAND "3DFACE" P35 P31 P32 P36 "")
  92.              (COMMAND "3DFACE" P32 P36 P37 P33 "")
  93.              (COMMAND "3DFACE" P33 P37 P38 P34 "")
  94.              (COMMAND "3DFACE" P34 P38 P35 P31 "")
  95. (SETVAR "BLIPMODE" 1)
  96. )
  97.